home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / pull5x.zip / PULLSHEL.ZIP / PULLSTAT.PAS < prev    next >
Pascal/Delphi Source File  |  1989-01-10  |  12KB  |  344 lines
  1. { =========================================================================== }
  2. { PullStat.pas - User Statistics for pull-down menus.       ver 5.X, 01-07-89 }
  3. {                                                                             }
  4. { This file contains all the data for GetUserPullStats, GetOverrideStats and  }
  5. { CheckGlobalKeys to configure the menus.                                     }
  6. {   Copyright (c) 1987-1989 James H. LeMay, All rights reserved.              }
  7. { =========================================================================== }
  8.  
  9. { R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ }         { TP4 directives }
  10. {$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}    { TP5 directives }
  11.  
  12. {$define UseSubMenuCode }
  13. {$define UseHelpWndwCode }
  14. {$define UseDataEntryCode }
  15. {$define UseMsgLineCode }
  16.  
  17. UNIT PullStat;
  18.  
  19. INTERFACE
  20.  
  21. uses
  22.   Crt,Qwik,Wutil,Wndw,Pull;
  23.  
  24. { ------------------ Set up your window names here in order: ---------------- }
  25. { This is optional, but it sure helps you in not only understanding the
  26.   program, but also makes it unquestionably easier to rearrange.              }
  27.  
  28. type
  29.   MainMenuNames = (NoMainMenu,FirstMenu,QuitMenu);
  30.   SubMenuNames  = (NoSubMenu,MySubMenu);
  31.   { These names are reserved up to HelpML and must match those in PULL.PAS. }
  32.   MsgLineNames = (NoML,WorkML,TopML,AltML,MainML,SubML,DW_ML,DE_ML,
  33.                   SeqML,HelpML,ProcML);
  34.   HelpWndwNames = (NoHW,WorkWndwHW,TopLineHW,MainMenuHW,SubMenuHW,DataWndwHW);
  35.   HelpLineNames = (
  36.     NoHL,      { HL - HelpLine;  L - Last }
  37.     HLw1,HLwL, { Work window }
  38.     HLt1,HLtL, { Top Line menu }
  39.     HLm1,HLmL, { Main menu }
  40.     HLs1,HLsL, { Submenu }
  41.     HLd1,HLd2,HLd3,HLd4,HLd5,HLd6,HLdL); { Data window }
  42.   DataWndwNames = (NoDW,aByteDW);
  43.  
  44. { Careful! - Always test your last main menu, submenu, data window, and help
  45.   window for run-time error!  It makes sure you have allotted enough memory
  46.   with your constants.  The compiler cannot check it with these typed scalars.}
  47.  
  48. procedure GetUserPullStats;
  49. procedure GetOverrideStats;
  50. procedure CheckGlobalKeys;
  51.  
  52.  
  53. IMPLEMENTATION
  54.  
  55. { -- Trivial utilities to get and save a menu record fro the heap -- }
  56. procedure GetMainMenu (Name: MainMenuNames);
  57. begin
  58.   MRI := ord (Name);
  59.   TopMenu := MainMenu^[MRI];
  60. end;
  61.  
  62. procedure SaveMainMenu;
  63. begin
  64.   MainMenu^[MRI] := TopMenu;
  65. end;
  66.  
  67. {$ifdef UseSubMenuCode }
  68. procedure GetSubMenu (Name: SubMenuNames);
  69. begin
  70.   MRI := ord (Name);
  71.   TopMenu := SubMenu^ [MRI];
  72. end;
  73.  
  74. procedure SaveSubMenu;
  75. begin
  76.   SubMenu^[MRI] := TopMenu;
  77. end;
  78. {$endif }
  79.  
  80. {$ifdef UseHelpWndwCode }
  81. procedure SetHelpLines (Name: HelpWndwNames; First,Last: HelpLineNames);
  82. begin
  83.   HelpWndw[ord(Name)].FirstLine := ord(First);
  84.   HelpWndw[ord(Name)].LastLine  := ord(Last);
  85. end;
  86. {$endif }
  87.  
  88. { ============================ EXEC PROCEDURES ============================== }
  89. { Place procedures for execution by menu pointers, ProcPtr, here.             }
  90. { They MUST be set to FAR calls.                                              }
  91. { --------------------------------------------------------------------------- }
  92.  
  93. {$F+}
  94. procedure DummyProc;
  95. begin
  96.   {$ifdef UseMsgLineCode }
  97.   ShowMsg (ord(ProcML));
  98.   {$endif UseMsgLineCode }
  99.   Delay (1000)
  100. end;
  101.  
  102. procedure SetQuit;
  103. begin
  104.   PopToWorkWndw := true;
  105.   Quit := true;
  106. end;
  107.  
  108. {$F-}
  109.  
  110. { ======================== GetUserPullStats ================================= }
  111. { The major configurations for all menus go here.  The program first clears   }
  112. { all RECORD values to $00.  The values below will set new values. Therefore, }
  113. { setting RECORD values to "false" or the like is not necessary.              }
  114. { --------------------------------------------------------------------------- }
  115.  
  116. procedure GetUserPullStats;
  117. begin
  118.   LocationWarning:=true;   { If true and a Submenu won't fit, a message is
  119.                              displayed. If false, you can override the
  120.                              location without the message. }
  121.  
  122.   { ------------------ Set up your colors and borders here: ---------------- }
  123.   TopLineAttr   := Black+LightGrayBG;
  124.   TopLineHattr  := White+BlackBG;
  125.  
  126.   MainMenuBattr := LightGray+BlackBG;
  127.   MainMenuHattr := Black+LightGrayBG;
  128.   MainMenuLattr := Yellow+BlackBG;
  129.   MainMenuCattr := LightGray+BlackBG;
  130.   Brdr[UserBrdr1].BrdrArray := '╒═╕││└─┘╞═╡╤│┴╪';
  131.   MainMenuBrdr  := UserBrdr1;
  132.  
  133.   {$ifdef UseSubMenuCode }
  134.   SubMenuWattr  := Black+CyanBG;
  135.   SubMenuBattr  := Black+CyanBG;
  136.   SubMenuBrdr   := SingleBrdr;
  137.   {$endif UseSubMenuCode }
  138.  
  139.   if VideoMode=7 then
  140.     begin
  141.       TopLineLattr := TopLineAttr;
  142.       MainMenuWattr:= LightGray+BlackBG;
  143.       {$ifdef UseSubMenuCode }
  144.       SubMenuHattr := Black    +LightGrayBG;
  145.       SubMenuLattr := White    +BlackBG;
  146.       SubMenuCattr := LightGray+BlackBG;
  147.       {$endif UseSubMenuCode }
  148.     end
  149.   else
  150.     begin
  151.       TopLineLattr := Red  +LightGrayBG;
  152.       MainMenuWattr:= White+BlackBG;
  153.       {$ifdef UseSubMenuCode }
  154.       SubMenuHattr := White+BlueBG;
  155.       SubMenuLattr := White+CyanBG;
  156.       SubMenuCattr := Blue +CyanBG;
  157.       {$endif UseSubMenuCode }
  158.     end;
  159.  
  160.   {$ifdef UseHelpWndwCode }
  161.   HelpWndwWattr := Black+GreenBG;
  162.   HelpWndwBattr := Black+LightGrayBG;
  163.   HelpWndwBrdr  := HdoubleBrdr;
  164.   HelpWndwModes := ZoomMode+ShadowRight+CursorOffMode;
  165.   HelpBottomRow := CRTrows-4;
  166.   {$endif UseHelpWndwCode }
  167.  
  168.   {$ifdef UseMsgLineCode }
  169.   MsgLineAttr   := Green+BlackBG;
  170.   KeyStatusAttr := Black+GreenBG;
  171.   ErrMsgAttr    := Yellow+RedBG;
  172.   MsgLineRow    := CRTrows;
  173.   {$endif UseMsgLineCode }
  174.  
  175.  
  176.   { ------------------------- Top Menu defaults ----------------------------- }
  177.   TopLineRow := 2;      { Top line menu to appear on row 2 }
  178.   MPulled    := ord(FirstMenu);  { Main menu title to be HiLited by F10. }
  179.   MoreCmdSeq := 'F';    { Sequence of command letter(s) as if keyed in.  This }
  180.                         { will be the default menu(s) pulled. }
  181.   PullDown   := false;  { Set this true if you want the command sequence}
  182.                         {  to pull down the menus at startup. }
  183.  
  184.   { ------------------- Set up your MainMenu records here: ------------------ }
  185.   MainMenuRow := 3;       { First row of Main menus to appear on screen row 3 }
  186.  
  187.   with TopMenu do
  188.   begin
  189.  
  190.     GetMainMenu (FirstMenu);
  191.     MenuMode := SingleChoice;
  192.     SingleFlagLine := 3;
  193.     Title   := 'First';
  194.     Line[1] := 'A line';
  195.     Line[2] := 'B line';
  196.     Line[3] := 'C line';
  197.     Line[4] := 'D line';
  198.     DefaultLine := 2;
  199.     MsgLineNum  := ord(MainML);
  200.     HelpWndwNum := ord(MainMenuHW);
  201.     SaveMainMenu;
  202.  
  203.     GetMainMenu (QuitMenu);
  204.   { MenuMode := ExecChoice; }   { This is the default }
  205.     Title   := 'Quit';
  206.     Line[1] := 'Stay';
  207.     Line[2] := 'Quit';          ProcPtr[2] := @SetQuit;
  208.     BackToDefault := true;
  209.     MsgLineNum  := ord(MainML);
  210.     HelpWndwNum := ord(MainMenuHW);
  211.     SaveMainMenu;
  212.  
  213.   { ----------------------- Set up your SubMenus here: --------------------- }
  214.   { Careful! -- indexes to SubMenus must be numbered in order of level; i.e.,}
  215.   { ALL SubMenus first, ALL SubSubMenus second, ALL SubSubSubMenus, ... etc. }
  216.  
  217.     {$ifdef UseSubMenuCode }
  218.  
  219.     GetSubMenu (MySubMenu);
  220.     MenuMode := SingleChoice;
  221.     SingleFlagLine := 5;
  222.     Line[1] := '1 line';
  223.     Line[2] := '2 line';
  224.     Line[3] := '3 line';
  225.     Line[4] := '4 line';
  226.     MsgLineNum  := ord(SubML);
  227.     HelpWndwNum := ord(SubMenuHW);
  228.     SaveSubMenu;
  229.  
  230.     {$endif UseSubMenuCode }
  231.  
  232.   end;  { with TopMenu }
  233.  
  234.   { ------------------ Set up your Message Lines here: ---------------------- }
  235.   { Concatenations here allow source to print on 80 col printer.              }
  236.   { All messages up to HelpML are reserved.                                   }
  237.  
  238.   {$ifdef UseMsgLineCode }
  239.   MsgLine[ord(WorkML)] :=' F1-help  F2-pull  F10-top';
  240.   MsgLine[ord(TopML)] :=' F1-help  F2-pop   LTR-cmd  ESC-return  '+
  241.                         '        '^[^Z' hilight            CR-select';
  242.   MsgLine[ord(AltML)] :=' Alt: F-First                           '+
  243.                         '                                 X-Exit';
  244.   MsgLine[ord(Mai